home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / THINKC / 5 / READER_1 / FDS__1_0 / SOUNDEDI / SOUNDEDI.P < prev   
Text File  |  1992-07-19  |  7KB  |  323 lines
  1. unit SoundEditFD;
  2.  
  3. interface
  4.  
  5.     uses
  6.         FormatDriver, Sound;
  7.  
  8.     function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
  9.  
  10. implementation
  11.  
  12.     function DoInit (system: SysEnvPtr): LongInt;
  13.     FORWARD;
  14.     function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
  15.     FORWARD;
  16.     procedure DoClose (window: WindowPtr);
  17.     FORWARD;
  18.     procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
  19.     FORWARD;
  20.     procedure DoMenuUpdate (window: WindowPtr);
  21.     FORWARD;
  22.     procedure DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle);
  23.     FORWARD;
  24.  
  25.     function Main (message: Integer; window: WindowPtr; param1, param2: LongInt): LongInt;
  26.     begin
  27.         Main := noErr;
  28.         case message of
  29.             rmInit: 
  30.                 Main := DoInit(SysEnvPtr(param1));
  31.             rmOpen: 
  32.                 Main := DoOpen(window, StringPtr(param1), LoWord(param2));
  33.             rmClose: 
  34.                 DoClose(window);
  35.             rmMenuSelect: 
  36.                 DoMenuSelect(window, param1, param2);
  37.             rmMenuUpdate: 
  38.                 DoMenuUpdate(window);
  39.             rmInControl: 
  40.                 DoInControl(window, Point(param1), ControlHandle(param2));
  41.         end;
  42.     end;
  43.  
  44.     const
  45.         errOldSystem = 1000;
  46.         errCantPlayIt = 1001;
  47.         errCompressed = 1002;
  48.  
  49.     type
  50.         INFOrecord = record
  51.                 reserved0: LongInt;
  52.                 reserved1: LongInt;
  53.                 recordFreq: Fixed;
  54.                 playbackFreq: Fixed;
  55.                 compressionMode: LongInt;        { 0 = none, 1 = 8:1, 2 = 4:1,  3 = 3:1, 4 = 6:1 }
  56.                 mode: LongInt;                    { 0 = mono, 1 = stereo }
  57.                 windowPosition: LongInt;
  58.                 sampleRate: LongInt;                { 1 = 22KHz, 2 = 11KHz, 3 = 7KHz, 4 = 5KHz }
  59.                 sampleLength: LongInt;
  60.                 rightSampleLen: LongInt;
  61.                 reserved10: LongInt;
  62.                 reserved11: LongInt;
  63.                 reserved12: LongInt;
  64.                 reserved13: LongInt;
  65.                 reserved14: LongInt;
  66.                 reserved15: LongInt;
  67.             end;
  68.         INFOptr = ^INFOrecord;
  69.         INFOhdl = ^INFOptr;
  70.  
  71.         DocumentRecord = record
  72.                 theData: Handle;
  73.                 theButton: ControlHandle;
  74.                 theItem: Integer;
  75.                 theINFO: INFOhdl;
  76.             end;
  77.         DocumentPtr = ^DocumentRecord;
  78.         DocumentHdl = ^DocumentPtr;
  79.  
  80. { ========== support routines ========== }
  81.  
  82.     procedure BeginFDriver (window: WindowPtr; var document: DocumentHdl);
  83.     begin
  84.         document := DocumentHdl(GetWRefCon(window));
  85.         HLock(Handle(document));
  86.     end;
  87.  
  88.     procedure EndFDriver (document: DocumentHdl);
  89.     begin
  90.         HUnlock(Handle(document));
  91.     end;
  92.  
  93. { ========== message handlers ========== }
  94.  
  95.     function DoInit (system: SysEnvPtr): LongInt;
  96.         const
  97.             goodSystem = $0602;
  98.     begin
  99.         DoInit := 0;
  100.         if system^.systemVersion < goodSystem then
  101.             begin
  102.                 InfoAlert(errOldSystem);
  103.                 DoInit := rmError;
  104.             end;
  105.     end;
  106.  
  107.     function DoOpen (window: WindowPtr; fileName: StringPtr; vRefNum: Integer): OSErr;
  108.         var
  109.             document: DocumentHdl;
  110.             refNum: Integer;
  111.             logEOF: LongInt;
  112.             theHdl: Handle;
  113.             theControl: ControlHandle;
  114.             error: OSErr;
  115.     begin
  116.         error := FSOpen(fileName^, vRefNum, refNum);
  117.         if error <> noErr then
  118.             begin
  119.                 DoOpen := error;
  120.                 Exit(DoOpen);
  121.             end;
  122.  
  123.         error := GetEOF(refNum, logEOF);
  124.         if error <> noErr then
  125.             begin
  126.                 DoOpen := error;
  127.                 error := FSClose(refNum);
  128.                 Exit(DoOpen);
  129.             end;
  130.  
  131.         theHdl := NewHandle(logEOF);
  132.         if (theHdl = nil) then
  133.             begin
  134.                 DoOpen := memFullErr;
  135.                 error := FSClose(refNum);
  136.                 Exit(DoOpen);
  137.             end;
  138.  
  139.         HLock(theHdl);
  140.         error := FSRead(refNum, logEOF, theHdl^);
  141.         HUnlock(theHdl);
  142.         if error <> noErr then
  143.             begin
  144.                 DoOpen := error;
  145.                 DisposHandle(theHdl);
  146.                 error := FSClose(refNum);
  147.                 Exit(DoOpen);
  148.             end;
  149.         error := FSClose(refNum);
  150.  
  151.         theControl := GetNewControl(1000, window);
  152.         if ResError <> noErr then
  153.             begin
  154.                 DoOpen := ResError;
  155.                 DisposHandle(theHdl);
  156.                 Exit(DoOpen);
  157.             end;
  158.  
  159.         document := DocumentHdl(NewHandle(sizeof(DocumentRecord)));
  160.         if (document = nil) then
  161.             begin
  162.                 DoOpen := memFullErr;
  163.                 DisposeControl(theControl);
  164.                 DisposHandle(theHdl);
  165.                 Exit(DoOpen);
  166.             end;
  167.  
  168.         HLock(Handle(document));
  169.         with document^^ do
  170.             begin
  171.                 theData := theHdl;
  172.                 theButton := theControl;
  173.                 theItem := 2;
  174.                 theINFO := nil;
  175.                 refNum := OpenRFPerm(fileName^, vRefNum, fsRdPerm);
  176.                 if refNum <> -1 then
  177.                     begin
  178.                         theINFO := INFOhdl(Get1Resource('INFO', 1000));
  179.                         if (theINFO <> nil) then
  180.                             begin
  181.                                 theItem := theINFO^^.sampleRate + 1;
  182.                                 DetachResource(Handle(theINFO));
  183.                             end;
  184.                         CloseResFile(refNum);
  185.                     end;
  186.             end;
  187.         HUnlock(Handle(document));
  188.         SetWRefCon(window, LongInt(document));
  189.  
  190.         with document^^ do
  191.             if theINFO <> nil then
  192.                 if theINFO^^.compressionMode > 0 then
  193.                     begin
  194.                         DoClose(window);
  195.                         InfoAlert(errCompressed);
  196.                         DoOpen := rmError;
  197.                         Exit(DoOpen);
  198.                     end;
  199.  
  200.         SizeWindow(window, 300, 100, true);
  201.         MoveWindow(window, 80, 80, false);
  202.         DoOpen := noErr;
  203.     end;
  204.  
  205.     procedure DoClose (window: WindowPtr);
  206.         var
  207.             document: DocumentHdl;
  208.     begin
  209.         BeginFDriver(window, document);
  210.         with document^^ do
  211.             begin
  212.                 if theINFO <> nil then
  213.                     DisposHandle(Handle(theINFO));
  214.                 DisposHandle(theData);
  215.             end;
  216.         EndFDriver(document);
  217.  
  218.         DisposHandle(Handle(document));
  219.     end;
  220.  
  221.     procedure DoMenuSelect (window: WindowPtr; menuID, menuItem: Integer);
  222.         var
  223.             document: DocumentHdl;
  224.     begin
  225.         BeginFDriver(window, document);
  226.  
  227.         if menuID = 1000 then
  228.             document^^.theItem := menuItem;
  229.  
  230.         EndFDriver(document);
  231.     end;
  232.  
  233.     procedure DoMenuUpdate (window: WindowPtr);
  234.         var
  235.             document: DocumentHdl;
  236.             menu: MenuHandle;
  237.             index: Integer;
  238.             disable: Boolean;
  239.     begin
  240.         menu := GetMHandle(1000);
  241.         if menu = nil then
  242.             Exit(DoMenuUpdate);
  243.  
  244.         BeginFDriver(window, document);
  245.  
  246.         disable := (document^^.theINFO <> nil);
  247.  
  248.         for index := 1 to CountMItems(menu) do
  249.             begin
  250.                 CheckItem(menu, index, false);
  251.                 if disable then
  252.                     DisableItem(menu, index)
  253.                 else
  254.                     EnableItem(menu, index);
  255.             end;
  256.         CheckItem(menu, document^^.theItem, true);
  257.  
  258.         EndFDriver(document);
  259.     end;
  260.  
  261.     procedure DoInControl (window: WindowPtr; mouseLoc: Point; control: ControlHandle);
  262.         var
  263.             document: DocumentHdl;
  264.             error: OSErr;
  265.             chan: SndChannelPtr;
  266.             cmd: SndCommand;
  267.             sample: SoundHeader;
  268.     begin
  269.         BeginFDriver(window, document);
  270.  
  271.         with document^^ do
  272.             begin
  273.                 if TrackControl(control, mouseLoc, nil) <> 0 then
  274.                     if control = theButton then
  275.                         begin
  276.                             chan := nil;
  277.                             error := SndNewChannel(chan, sampledSynth, initMono, nil);
  278.                             if error <> noErr then
  279.                                 begin
  280.                                     InfoAlert(errCantPlayIt);
  281.                                     EndFDriver(document);
  282.                                     Exit(DoInControl);
  283.                                 end;
  284.  
  285.                             SetCursor(GetCursor(watchCursor)^^);
  286.                             HLock(theData);
  287.                             with sample do
  288.                                 begin
  289.                                     samplePtr := theData^;
  290.                                     length := GetHandleSize(theData);
  291.                                     case theItem of
  292.                                         1: 
  293.                                             sampleRate := $AC440000;
  294.                                         2: 
  295.                                             sampleRate := $56EE8BA3;
  296.                                         3: 
  297.                                             sampleRate := $2B7745D1;
  298.                                         4: 
  299.                                             sampleRate := $1CFA2E8B;
  300.                                         5: 
  301.                                             sampleRate := $15BBA2E8;
  302.                                     end;
  303.                                     loopStart := 1;
  304.                                     loopEnd := length;
  305.                                     baseFrequency := 60;
  306.                                 end;
  307.                             cmd.cmd := bufferCmd;
  308.                             cmd.param1 := 0;
  309.                             cmd.param2 := LongInt(@sample);
  310.                             error := SndDoImmediate(chan, cmd);
  311.                             if error <> noErr then
  312.                                 InfoAlert(errCantPlayIt);
  313.  
  314.                             error := SndDisposeChannel(chan, false);
  315.                             HUnlock(theData);
  316.                             InitCursor;
  317.                         end;
  318.             end;
  319.  
  320.         EndFDriver(document);
  321.     end;
  322.  
  323. end.